Tips&Tricks

I trucchi del mestiere

Come posizionare il mouse su un controllo presente nel form

Questa routine pu≥ essere utilizzata per posizionare il puntatore del mouse su un particolare controllo presente all'interno di un form. Per esempio in una finestra di dialogo si pu≥ posizionare, automaticamente, il cursore sul bottone OK. Per realizzare questa particolare funzione la routine ricorre a due API di sistema: ClientToScreen e SetCursorPos.

Option Explicit

Private Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long

Private Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
Private Type POINTAPI
    X As Long
    Y As Long
End Type

Private Sub CenterMouseOverControl(ByVal ctl As Control)
Dim pt As POINTAPI
    ClientToScreen ctl.hwnd, pt
    SetCursorPos _
        pt.X + ScaleX(ctl.Width / 2, ScaleMode, vbPixels), _
        pt.Y + ScaleY(ctl.Height / 2, ScaleMode, vbPixels)
End Sub

Private Sub Button1_Click(Index As Integer)
    CenterMouseOverControl cmdPositionMouse((Index + 1) Mod 3)
End Sub

Come downloadare e visualizzare un'immagine dal Web

Poche righe di codice per realizzare una simpatica funzione che permette di downloadare dal Web una qualunque immagine e di visualizzare questa all'interno della propria applicazione. Per utilizzare la funzione Φ necessario aggiungere al form VB il controllo INET.

Option Explicit

Private Sub cmdGo_Click()
Dim bytes() As Byte
Dim fnum As Integer

    cmdGo.Enabled = False
    txtFile.Enabled = False
    txtURL.Enabled = False
    picResult.Picture = Nothing
    Screen.MousePointer = vbHourglass
    DoEvents
    bytes() = inetDownload.OpenURL(txtURL.Text, icByteArray)
    fnum = FreeFile
    Open txtFile.Text For Binary Access Write As #fnum
    Put #fnum, , bytes()
    Close #fnum

    picResult.Picture = LoadPicture(txtFile.Text)
    If ScaleHeight < picResult.Top + picResult.Height + 120 Then
        Height = picResult.Top + picResult.Height + _
            120 + Height - ScaleHeight
    End If

    cmdGo.Enabled = True
    txtFile.Enabled = True
    txtURL.Enabled = True
    Screen.MousePointer = vbDefault
    Beep
End Sub

Private Sub Form_Load()
Dim dir_name As String
    dir_name = App.Path
    If Right$(dir_name, 1) <> "\" Then dir_name = dir_name & "\"
    txtFile.Text = dir_name & "vbhelper.gif"
End Sub

Come spostare un form da ogni lato

Notoriamente, cliccando su uno dei 4 lati di un generico form, si realizza l'operazione di resize del form stesso. Grazie al tip proposto, Φ possibile trasformazione l'operazione di resize in un'operazione di spostamento del foglio. Sarα cos∞ possibile muovere a proprio piacimento il form semplicemente cliccando e trascinando uno qualsiasi dei suoi lati

Inserire il codice che segue in un modulo:

Option Explicit

Public OldWindowProc As Long

Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As 
Long, ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As 
Long) As Long
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Public Const GWL_WNDPROC = (-4)
Public Const WM_USER = &H400


Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const WM_NCLBUTTONDOWN = &HA1

Private Const HTCAPTION = 2

Public Function NewWindowProc(ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Static num As Long

Const WM_NCLBUTTONDOWN = &HA1

Const HTBORDER = 18
Const HTBOTTOM = 15
Const HTBOTTOMLEFT = 16
Const HTBOTTOMRIGHT = 17
Const HTCAPTION = 2
Const HTCLOSE = 20
Const HTGROWBOX = 4
Const HTLEFT = 10
Const HTMAXBUTTON = 9
Const HTMINBUTTON = 8
Const HTRIGHT = 11
Const HTSYSMENU = 3
Const HTTOP = 12
Const HTTOPLEFT = 13
Const HTTOPRIGHT = 14

Dim skip_it As Boolean

    If msg = WM_NCLBUTTONDOWN Then
        Select Case wParam
            Case HTBORDER, HTBOTTOM, _
              HTBOTTOMLEFT, HTBOTTOMRIGHT, _
              HTLEFT, HTRIGHT, HTTOP, _
              HTTOPLEFT, HTTOPRIGHT, HTGROWBOX
                ' Move the form.
                ReleaseCapture
                SendMessage hwnd, WM_NCLBUTTONDOWN, HTCAPTION, ByVal 0&
                skip_it = True
        End Select
    End If
    num = num + 1

    If Not skip_it Then
        NewWindowProc = CallWindowProc(OldWindowProc, hwnd, msg, wParam, _
            lParam)
    End If
End Function

Inserire il codice che segue in un form

Option Explicit

Private Const HTBORDER = 18
Private Const HTBOTTOM = 15
Private Const HTBOTTOMLEFT = 16
Private Const HTBOTTOMRIGHT = 17
Private Const HTCAPTION = 2
Private Const HTCLOSE = 20
Private Const HTLEFT = 10
Private Const HTMAXBUTTON = 9
Private Const HTMINBUTTON = 8
Private Const HTRIGHT = 11

Private Sub Form_Load()
    OldWindowProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf NewWindowProc)
End Sub

Private Sub Form_Unload(Cancel As Integer)
    SetWindowLong hwnd, GWL_WNDPROC, OldWindowProc
End Sub

Private Sub mnuFileExit_Click()
    Unload Me
End Sub

Come eseguire un'applicazione nella shell e attenderne la fine dell'esecuzione

Molte volte capita di dover eseguire un programma esterno, ponendo in "pausa" la propria applicazione e attendendo la fine dell'esecuzione dell'applicazione esterna. Il tip proposto consente proprio di realizzare questa utilissima funzione.

Private Type STARTUPINFO 
      		cb		As Long
      		lpReserved	As String
      		lpDesktop	As String
      		lpTitle		As String
      		dwX		As Long
      		dwY		As Long
      		dwXSize		As Long
      		dwYSize		As Long
      		dwXCountChars	As Long
      		dwYCountChars	As Long
      		dwFillAttribute	As Long
      		dwFlags		As Long
      		wShowWindow	As Integer
      		cbReserved2	As Integer
      		lpReserved2	As Long
      		hStdInput	As Long
      		hStdOutput	As Long
      		hStdError	As Long
End Type 

Private Type PROCESS_INFORMATION 
		hProcess	As Long
		hThread		As Long
      		dwProcessID	As Long
      		dwThreadID	As Long
End Type

Private Declare Function WaitForSingleObject Lib "kernel32" _
	(ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long

	Private Declare Function CreateProcessA Lib "kernel32" (ByVal _ 
	lpApplicationName As Long, ByVal lpCommandLine As String, ByVal _
      	lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, _
      	ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, _
      	ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As Long, _
      	lpStartupInfo As STARTUPINFO, lpProcessInformation As _
      	PROCESS_INFORMATION) As Long

	Private Declare Function CloseHandle Lib "kernel32" (ByVal _ 
	hObject As Long) As Long

	Private Const NORMAL_PRIORITY_CLASS = &H20&
	Private Const INFINITE = -1& 

Public Sub ExecCmd(cmdline As String) 

	Dim proc As PROCESS_INFORMATION
      	Dim start As STARTUPINFO
      	start.cb = Len(start)
      	ret& = CreateProcessA(0&, cmdline, 0&, 0&, 1&,  NORMAL_PRIORITY_CLASS, 0&, 
0&, start, proc)
     	ret& = WaitForSingleObject(proc.hProcess, INFINITE)
      	ret& = CloseHandle(proc.hProcess)

End Sub 

Sub Form_Click () 
      ExecCmd "notepad.exe"
      MsgBox "Process ultimato"
End Sub

Come cambiare lo sfondo del desktop

E' possibile cambiare lo sfondo del desktop da un'applicazione Visual Basic? La risposta e si e di seguito ne proponiamo l'implementazione

Declare Function SystemParametersInfo Lib "user32" Alias _
"SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, _
ByVal lpvParam As Any, ByVal fuWinIni As Long) As Long

Public Const SPIF_SENDWININICHANGE = &H2

Public Const SPI_SETDESKWALLPAPER = 20
Public Const SPIF_UPDATEINIFILE = &H1


Sub CambiaSfondo(NomeFile as string)
	SystemParametersInfo SPI_SETDESKWALLPAPER, 0, NomeFile, _
	SPIF_UPDATEINIFILE Or SPIF_SENDWININICHANGE
End Sub